open Unix
open Sys

open Common
open Io
open Ftp_session

(******************************************************************************)

exception Host_not_found
exception Control_connect_failed
exception Resolve_failed
exception Connect_reset
exception Login_failed
exception Get_passive_port_failed
exception Data_connect_failed
exception Reset_failed
exception File_write_failed
exception File_lseek_failed
exception Cmd_sent_failed
exception Data_write_failed
exception Cmd_interrupted
exception Time_out

(******************************************************************************)

(* Format Control Codes *)
type ty_form_code =
  | NONPRINT
  | TELNET
  | CARRIAGE

(* Gets the string representation of the format control code. *)
let string_of_form_code = function
  | NONPRINT -> "N"
  | TELNET -> "T"
  | CARRIAGE -> "C"

(* Data Types *)
type ty_type_code =
  | ASIIC of ty_form_code
  | EBCDIC of ty_form_code
  | IMAGE
  | LOCAL of int

(* Gets the string representation of the data type. *)
let string_of_type_code = function
  | ASIIC form_code -> "A"^" "^(string_of_form_code form_code)
  | EBCDIC form_code -> "E"^" "^(string_of_form_code form_code)
  | IMAGE -> "I"
  | LOCAL byte_size -> "L"^" "^(string_of_int byte_size)

(* Data Structures *)
type ty_structure_code =
  | FILE
  | RECORD
  | PAGE

(* Gets the string representation of the data structure *)
let string_of_structure_code = function
  | FILE -> "F"
  | RECORD -> "R"
  | PAGE -> "P"

(* Transmission Modes *)
type ty_mode_code =
  | STREAM
  | BLOCK
  | COMPRESS

(* Gets the string representation of the transimission mode *)
let string_of_mode_code = function
  | STREAM -> "S"
  | BLOCK -> "B"
  | COMPRESS -> "C"

type protection_level =
  | CLEAR
  | SAFE
  | CONFIDENTIAL
  | PRIVATE

let string_protection_level = function
  | CLEAR -> "C"
  | SAFE -> "S"
  | CONFIDENTIAL -> "E"
  | PRIVATE -> "P"

(* Raw Ftp Commands (RFC959,2389,3659) *)
type ty_ftp_cmd =
  (* commands defined in RFC959 *)
  | USER of string
  | PASS of string
  | ACCT of string
  | CWD of string
  | CDUP
  | SMNT of string
  | QUIT 
  | REIN
  | PORT of int*int*int*int*int*int
  | PASV
  | TYPE of ty_type_code
  | STRU of ty_structure_code
  | MODE of ty_mode_code
  | RETR of string
  | STOR of string
  | STOU of string
  | APPE of string
  | ALLO of int64
  | REST of int64
  | RNFR of string
  | RNTO of string
  | ABOR 
  | DELE of string
  | RMD of string
  | MKD of string
  | PWD
  | LIST of string
  | NLST of string
  | SITE of string
  | SYST
  | STAT of string
  | HELP of string
  | NOOP
  (* commands defined in RFC2389 *)
  | FEAT
  (* commands defined in RFC3659 *)
  | SIZE of string
  | MDTM of string
  | MLST of string
  | MLSD of string 
  (* commands defined in RFC2228 *)
  (*
  | AUTH of string 
  | ADAT of string
  | PBSZ of int32
  | PROT of protection_level
  | CCC
  | MIC of string
  | CONF of string
  | ENC of string
  *)
    
(* Gets the string representation of the raw ftp command *)
let string_of_ftp_cmd = function
  | USER username -> "USER "^username
  | PASS password -> "PASS "^password
  | ACCT acctinfo -> "ACCT "^acctinfo
  | CWD pathname -> "CWD "^pathname
  | CDUP -> "CDUP"
  | SMNT pathname -> "SMNT "^pathname
  | QUIT -> "QUIT"
  | REIN -> "REIN"
  | PORT (h1,h2,h3,h4,p1,p2) -> "PORT "^(string_of_int h1)^","^(string_of_int h2)^","^(string_of_int h3)^","^(string_of_int h4)^","^(string_of_int p1)^","^(string_of_int p2)
  | PASV -> "PASV"
  | TYPE type_code -> "TYPE "^(string_of_type_code type_code)
  | STRU structure_code -> "STRU "^(string_of_structure_code structure_code)
  | MODE mode_code -> "MODE "^(string_of_mode_code mode_code)
  | RETR pathname -> "RETR "^pathname
  | STOR pathname -> "STOR "^pathname
  | STOU pathname -> "STOU "^pathname
  | APPE pathname -> "APPE "^pathname
  | ALLO size -> "ALLO "^(Int64.to_string size)
  | REST marker -> "REST "^(Int64.to_string marker)
  | RNFR pathname -> "RNFR "^pathname
  | RNTO pathname -> "RNTO "^pathname
  | ABOR -> "ABOR"
  | DELE pathname -> "DELE "^pathname
  | RMD pathname -> "RMD "^pathname
  | MKD pathname -> "MKD "^pathname
  | PWD -> "PWD"
  | LIST pathname -> "LIST "^pathname
  | NLST pathname -> "NLST "^pathname
  | SITE site_cmd -> "SITE "^site_cmd
  | SYST -> "SYST"
  | STAT pathname -> "STAT "^pathname
  | HELP cmd -> "HELP "^cmd
  | NOOP -> "NOOP"
  | FEAT -> "FEAT"
  | SIZE pathname -> "SIZE "^pathname
  | MDTM pathname -> "MDTM "^pathname
  | MLST pathname -> "MLST "^pathname
  | MLSD pathname -> "MLSD "^pathname

(******************************************************************************)

(*
type control_connect =
    { host : host_entry;       (* host of ftp server *)
      socket_fd : file_descr   (* socket to ftp server *)             
    }

let default_connect =
  { host = gethostbyname (gethostname ());
    socket_fd = stdout;
  }

type auth_info =
    { username : string;
      password : string;
      acctinfo : string;
    }

let anonymous_auth_info =
  { username = "anonymous";
    password = "xxx@xxx.xxx";
    acctinfo = "";
  }

type x_feature =
    { mutable size : bool;
      mutable rest : bool;
      mutable mdtm : bool;
      mutable mlst : bool;
      mutable mlsd : bool;
    }

let emp_x_features =
  { size = false;
    rest = false;
    mdtm = false;
    mlst = false;
    mlsd = false;    
  }

type ftp_session =
    { cc : control_connect;
      auth : auth_info;
      x_feats : x_feature;
      mutable passive : bool;
      mutable closed : bool;
    }

let default_ftp_session =
  { cc = default_connect;
    auth = anonymous_auth_info;
    x_feats = emp_x_features;
    passive = true;
    closed = true;
  }
*)

(******************************************************************************)

let int_on () =
  set_signal sigint Signal_default

let int_off () =
  set_signal sigint Signal_ignore

(******************************************************************************)

let resolve host =
  let host_entry = 
    try 
      gethostbyname host
    with
    | Not_found -> raise Host_not_found
  in
  host_entry

let open_control_connection host_entry port =
  let ctrl =
    try 
      socket PF_INET SOCK_STREAM 0
    with
    | _ ->
        raise Control_connect_failed
  in
  let socket_addr =
    ADDR_INET ((host_entry.h_addr_list).(0), port)
  in
  try
    connect ctrl socket_addr;
    { host = host_entry;
      socket_fd = ctrl;
    }
  with
  | Unix_error (errno, str1, str2) ->
      print_debug_msg (str1^"("^str2^") : "^(error_message errno)^"\n");
      raise Control_connect_failed

(******************************************************************************)

let send_command cc cmd =
  let converted = 
    iconv_line (string_of_ftp_cmd cmd) !console_charset !server_charset
  in
  let cmd_str = converted^"\r\n" in
  print_debug_msg ("--->"^cmd_str);
  let len = String.length cmd_str in
  (
   if (write cc.socket_fd cmd_str 0 len)<>len then
     raise Cmd_sent_failed;
   flush_all ()
  )

(******************************************************************************)

type telnet_cmd_code =
  | IAC
  | WILL
  | WONT
  | DO
  | DONT
  | OTHER

let to_telnet_cmd_code c =
  match c with
  | '\255' -> IAC
  | '\251' -> WILL
  | '\252' -> WONT
  | '\253' -> DO
  | '\254' -> DONT
  | _ -> OTHER

(******************************************************************************)

let get_reply_code reply =
  String.sub reply 0 3

let read_reply cc =
  let socket_fd = cc.socket_fd in
  let reply = ref "" in
  let buffer = String.create 1 in
  let start_reply_code = ref "" in
  let has_more msg = 
    msg.[0]=' ' || msg.[0]='\t' || msg.[3]='-' ||
    (String.compare !start_reply_code (get_reply_code msg))<>0
  in
  let one_line_reply = ref "" in
  let loop_cond = ref true in
  while !loop_cond do
    let _ = read socket_fd buffer 0 1 in
    let tel_cmd_code = to_telnet_cmd_code (String.get buffer 0) in
    match tel_cmd_code with
    | IAC ->
        print_debug_msg "<---IAC\n";
        let _ =read socket_fd buffer 0 1 in
        let c = String.get buffer 0 in
        let tel_cmd_code = 
          try
            to_telnet_cmd_code c 
          with
          | End_of_file -> 
              raise Connect_reset
        in
        (match tel_cmd_code with
        | WILL
        | WONT ->
            (let cmd_str =
              Printf.sprintf "%c%c%c" '\255' '\254' c
            in
            try
              let _ = write socket_fd cmd_str 0 3 in
              ()
            with
            | End_of_file ->
                raise Connect_reset)
        | DO
        | DONT ->
            (let cmd_str = 
              Printf.sprintf "%c%c%c" '\255' '\252' c
            in
            try
              let _ = 
                write socket_fd cmd_str 0 3 
              in
              ()
            with
            | End_of_file ->
                raise Connect_reset)
        | _ -> 
            ())
    | _ -> 
        one_line_reply := !one_line_reply^buffer;
        if (String.get buffer 0)='\n' then
          (print_debug_msg ("<---"^(!one_line_reply));
           if (String.compare !start_reply_code "")=0 then 
            start_reply_code := get_reply_code !one_line_reply;
           loop_cond := has_more !one_line_reply;
           reply := !reply^(!one_line_reply);
           one_line_reply := "")
  done;
  !reply

let feed_command cc cmd =
  send_command cc cmd;
  read_reply cc

(******************************************************************************)

let int_cmd cc =
  feed_command cc ABOR

(******************************************************************************)

let login_auth cc username password acctinfo =
  let session =
    { cc = cc;
      auth = { username = username;
               password = password;
               acctinfo = acctinfo;
             };
      x_feats = emp_x_features;
      passive = true;
      data_port = 0;
      workdir = "/";
      closed = true;
      charset = "C";
    }
  in
  let reply = 
    read_reply cc 
  in
  let reply_code = 
    get_reply_code reply
  in
  let login_ok () =
    session.closed <- false;
    session
  in
  let login_fail () =
    let socket_fd = cc.socket_fd in
    shutdown socket_fd SHUTDOWN_RECEIVE;
    raise Login_failed
  in
  let login_stage2 () =
    let handle_acct () =
      let reply_code = 
        get_reply_code (feed_command cc (ACCT acctinfo))
      in
      (match reply_code.[0] with
      | '2' -> 
          login_ok ()
      | _ -> 
          login_fail ())
    in
    let reply_code = 
      get_reply_code (feed_command cc (USER username)) 
    in
    (match reply_code.[0] with
    | '3' ->
        (match reply_code.[2] with
        | '1' -> (* 331 *)
            let reply_code = 
              get_reply_code (feed_command cc (PASS password))
            in
            (match reply_code.[0] with
            | '3' -> (* 332 *)
                handle_acct ()
            | '2' -> (* 230 *)
                login_ok ()
            | _ -> 
                login_fail ())
        | '2' -> (* 332 *)
            handle_acct ()
        | _ -> 
            login_fail ())
    | '2' -> 
        login_ok ()
    | _ -> 
        login_fail ())
  in
  match reply_code.[0] with
  | '2' -> (* 220 *)
      login_stage2 ()
  | '1' -> (* 110 *)
      let wait_time = 
        try 
          int_of_string (String.sub reply 4 3)
        with
        | _ -> 
            login_fail ()
      in
      sleep (wait_time*60);
      let reply_code = 
        get_reply_code (read_reply cc)
      in
      (match reply_code.[0] with
      | '2' -> (* 220 *)
          login_stage2 ()
      | _ -> 
          login_fail ())
  | _ -> 
      login_fail ()

let login host port username password acctinfo =
  let host_entry =
    try
      print_debug_msg ("Resolving "^host^"...");
      resolve host
    with
    | _ -> 
        raise Resolve_failed
  in
  print_debug_msg ((string_of_inet_addr (host_entry.h_addr_list).(0))^"\n");
  let cc = 
    try 
      print_debug_msg ("Connecting to "^host^":"^(string_of_int port)^"...");
      open_control_connection host_entry port
    with
    | _ -> 
        raise Control_connect_failed
  in
  print_debug_msg "done.\n";
  login_auth cc username password acctinfo
  
let logout session =
  if not session.closed then 
    (let cc = session.cc in 
    let reply_code = get_reply_code (feed_command cc QUIT) in
    match reply_code.[0] with
    | '2' 
    | _ ->
        let socket_fd = cc.socket_fd in
        shutdown socket_fd SHUTDOWN_RECEIVE;
        session.closed <- true)
  else
    ()

(******************************************************************************)

let change_work_dir cc pathname =
  let reply_code = get_reply_code (feed_command cc (CWD pathname)) in
  match reply_code.[0] with
  | '2' 
  | _ -> reply_code

let change_to_upper_dir cc =
  let reply_code = get_reply_code (feed_command cc CDUP) in
  match reply_code.[0] with
  | '5' -> 
      (match reply_code.[2] with
      | '2' -> 
          print_debug_msg "Try to use \'CWD ..\' to simulate \'CDUP\'\n";
          change_work_dir cc ".."
      | _ -> reply_code)
  | '2'
  | _ -> reply_code

let get_work_dir_name cc =
  let reply = feed_command cc PWD in
  let reply_code = get_reply_code reply in
  match reply_code.[0] with
  | '2' ->
      reply_code, 
      remove_trailing_cr_lf (String.sub reply 4 ((String.length reply)-4))
  | _ -> reply_code, ""

let remove_file cc pathname =
  let reply_code = get_reply_code (feed_command cc (DELE pathname)) in
  match reply_code.[0] with
  | '2' 
  | _ -> reply_code

let remove_dir cc pathname =
  let reply_code = get_reply_code (feed_command cc (RMD pathname)) in
  match reply_code.[0] with
  | '2'
  | _ -> reply_code

let create_dir cc pathname =
  let reply_code = get_reply_code (feed_command cc (MKD pathname)) in
  match reply_code.[0] with
  | '2'
  | _ -> reply_code

let rename_file cc orig_name new_name =
  let reply_code = get_reply_code (feed_command cc (RNFR orig_name)) in
  match reply_code.[0] with
  | '3' ->
      let reply_code = get_reply_code (feed_command cc (RNTO new_name)) in
      (match reply_code.[0] with
      | '2'
      | _ -> reply_code)
  | _ -> reply_code

(******************************************************************************)

let quote cc cmd_str =
  let sent_cmd_str = cmd_str^"\r\n" in
  let len = String.length sent_cmd_str in
  print_debug_msg ("--->"^sent_cmd_str);
  if (write cc.socket_fd sent_cmd_str 0 len)<>len then
    raise Cmd_sent_failed;
  flush_all ();
  read_reply cc

let site cc arg =
  feed_command cc (SITE arg)

(******************************************************************************)

let get_passive_port cc =
  let reply = 
    feed_command cc PASV 
  in
  let reply_code = 
    get_reply_code reply
  in
  match reply_code.[0] with
  | '2' -> 
      let pattern = 
        Str.regexp "227 Entering Passive Mode ([0-9]+,[0-9]+,[0-9]+,[0-9]+,\\([0-9]+\\),\\([0-9]+\\))"  
      in
      if not (Str.string_match pattern reply 0) then 
        raise Get_passive_port_failed
      else
        let higher_port = int_of_string (Str.matched_group 1 reply) in
        let lower_port = int_of_string (Str.matched_group 2 reply) in
        higher_port*256+lower_port
  | _ -> 
      raise Get_passive_port_failed

(******************************************************************************)

let init_data_connection session =
  let cc = session.cc in
  let data = 
    try
      socket PF_INET SOCK_STREAM 0 
    with
    | _ -> 
        raise Data_connect_failed
  in
  if session.passive then
    let port =
      try 
        get_passive_port cc
      with
      | _ ->
          raise Data_connect_failed
    in
    let socket_addr = 
      ADDR_INET ((cc.host.h_addr_list).(0), port)
    in
    (
     try
       connect data socket_addr 
     with
     | _ ->
         raise Data_connect_failed
    );
    data
  else
    let data_addr =
      ADDR_INET (inet_addr_any, 0)
    in
    (
     try
       bind data data_addr
     with
     | _ -> raise Data_connect_failed
    );
    let _, port =
      (
       match getsockname data with
       | ADDR_INET (a, p) -> 
           string_of_inet_addr a, p
       | _ -> 
           raise Data_connect_failed
      )
    in
    let addr, _ =
      (match getsockname cc.socket_fd with
      | ADDR_INET (a, p) ->
          string_of_inet_addr a, p
      | _ ->
          raise Data_connect_failed
      )
    in
    listen data 1;
    let pattern = Str.regexp "\\([0-9]+\\).\\([0-9]+\\).\\([0-9]+\\).\\([0-9]+\\)" in
    (
     if not (Str.string_match pattern addr 0) then 
       raise Data_connect_failed
     else
       let h1 = int_of_string (Str.matched_group 1 addr) in
       let h2 = int_of_string (Str.matched_group 2 addr) in
       let h3 = int_of_string (Str.matched_group 3 addr) in
       let h4 = int_of_string (Str.matched_group 4 addr) in
       let p1 = port/256 in
       let p2 = port-p1*256 in
       let reply_code = 
         get_reply_code (feed_command cc (PORT (h1,h2,h3,h4,p1,p2)))
       in
       (
        match reply_code.[0] with
        | '2' -> 
            ()
        | _ -> 
            raise Data_connect_failed
       )
    );
    data

let open_data_connection passive data =
  if passive then
    data
  else
    let s, _ =
      try
        accept data
      with
      | _ -> 
          raise Data_connect_failed
    in    
    close data;
    s

let close_data_connection data =
  close data

(******************************************************************************)

let recv_data session data_descr fout_descr time_out=
  let size = ref 1 in
  let data = 
    try
      open_data_connection session.passive data_descr
    with
    | Data_connect_failed ->
        close_data_connection data_descr;
        raise Data_connect_failed
  in
  let buf_size = 4096 in
  let buf = String.create buf_size in
  let old_timer_status = 
    setitimer ITIMER_REAL {it_interval = time_out; it_value = time_out;}
  in
  let old_sigalrm_handler = 
    Sys.signal Sys.sigalrm (Signal_handle (fun _ -> raise Time_out))
  in
  let finialize () = 
    ignore (setitimer ITIMER_REAL old_timer_status);
    ignore (Sys.signal Sys.sigalrm old_sigalrm_handler);
    (
     try 
       close_data_connection data
     with
     | _ -> ()
    );
    if fout_descr<>stdout then
      close fout_descr
  in
  (
   catch_break true;
   try
     while !size<>0 do
       size := read data buf 0 buf_size;
       ignore 
         (setitimer ITIMER_REAL {it_interval = time_out; it_value = time_out});
       if (write fout_descr buf 0 !size)<>(!size) then
         raise Data_write_failed;
     done
   with
   | End_of_file ->
       ()
   | Break ->
       send_command session.cc ABOR;
       close_data_connection data_descr;
       let _ = read_reply session.cc in ();
       print_debug_msg "Transfer aborted.\n";
       ()
   | Data_write_failed ->
       catch_break false;
       finialize ();
       raise Data_write_failed
   | Time_out ->
       catch_break false;
       finialize ();
       print_debug_msg "Time out!\n";
       raise Time_out
   | _ ->
       catch_break false;
       finialize ();
       raise Connect_reset);
  catch_break false;
  finialize ()

let recv_line data_descr =
  let line = ref "" in
  let loop_cond = ref true in
  (
   try 
     while !loop_cond do
       let c = getc data_descr in
       if c='\n' then
         loop_cond := false;
       line := !line ^ (String.make 1 c)
     done
   with
   | End_of_file ->
       raise End_of_file
   | _ ->
       raise Connect_reset
  );
  !line

let send_data session data_descr fin_descr time_out =
  let size = ref 1 in
  let data = 
      open_data_connection session.passive data_descr
  in
  let buf_size = 4096 in
  let buf = String.create buf_size in
  let old_timer_status =
    setitimer ITIMER_REAL {it_interval = time_out; it_value = time_out;}
  in
  let old_sigalrm_handler =
    Sys.signal Sys.sigalrm (Signal_handle (fun _ -> raise Time_out))
  in
  let finialize () =
    ignore (setitimer ITIMER_REAL old_timer_status);
    ignore (Sys.signal Sys.sigalrm old_sigalrm_handler);
    (
     try 
       close_data_connection data
     with
     | _ -> ()
    );
    if fin_descr<>stdin then
      close fin_descr
  in
  (
   catch_break true;   
   try
     while !size<>0 do
       size := read fin_descr buf 0 buf_size;
       if (write data buf 0 !size)<>(!size) then
         raise Data_write_failed;
       ignore 
         (setitimer ITIMER_REAL {it_interval = time_out; it_value = time_out})
     done
   with
   | End_of_file ->
       ()
   | Break ->
       send_command session.cc ABOR;
       close_data_connection data_descr;
       let _ = read_reply session.cc in ();
       print_debug_msg "Transfer aborted.\n";
       ()
   | Data_write_failed ->
       catch_break false;
       finialize ();
       raise Data_write_failed
   | Time_out ->
       catch_break false;
       finialize ();
       print_debug_msg "Time out!\n";
       raise Time_out
   | _ ->
       catch_break false;
       finialize ();
       raise Connect_reset);
  catch_break false;
  finialize ()

(******************************************************************************)

let get_file_list session pathname =
  let ret = ref [] in
  let cc = session.cc in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE (ASIIC NONPRINT)))
  in
  match reply_code.[0] with
  | '2' ->
      let data_descr = 
        try 
          init_data_connection session
        with
        | _ -> 
            raise Data_connect_failed
      in
      let reply_code = 
        get_reply_code (feed_command cc (NLST pathname)) 
      in
      (match reply_code.[0] with 
      | '1' -> 
          let data = 
            try
              open_data_connection session.passive data_descr
            with
            | Data_connect_failed ->
                close_data_connection data_descr;
                raise Data_connect_failed
          in
          (
           catch_break true;
           (
            try
              while true do
                let line = recv_line data in
                ret := (remove_trailing_cr_lf line) :: !ret
              done;
              catch_break false;
              close_data_connection data
            with
            | End_of_file ->
                catch_break false;
                close_data_connection data;
                ()
            | Break ->
                catch_break false;
                send_command cc ABOR;
                close_data_connection data;
                let _ = read_reply cc in ();
                print_debug_msg "Transfer aborted.\n";
                ()
            | _ ->
                catch_break false;
                close_data_connection data;
                raise Connect_reset
           );
           get_reply_code (read_reply cc), !ret
          )
      | _ -> 
          close_data_connection data_descr;
          reply_code, [])
  | _ -> 
      reply_code, []

let list_files session pathname =
  let cc = session.cc in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE (ASIIC NONPRINT)))
  in
  match reply_code.[0] with
  | '2' ->
      let data_descr = 
        try 
          init_data_connection session
        with
        | _ -> 
            raise Data_connect_failed
      in
      let reply_code = 
        get_reply_code (feed_command cc (LIST pathname)) 
      in
      (match reply_code.[0] with 
      | '1' -> 
          let data = 
            try
              open_data_connection session.passive data_descr
            with
            | Data_connect_failed ->
                close_data_connection data_descr;
                raise Data_connect_failed
          in
          (
           catch_break true;
           (
            try
              while true do
                let line = recv_line data in
                print_normal_msg (
                  (iconv_line (remove_trailing_cr_lf line) 
                              session.charset !console_charset)
                  ^"\n")
              done;
              catch_break false;
              close_data_connection data
            with
            | End_of_file ->
                catch_break false;
                close_data_connection data;
                ()
            | Break ->
                catch_break false;
                send_command cc ABOR;
                close_data_connection data;
                let _ = read_reply cc in ();
                print_debug_msg "Transfer aborted.\n";
                ()
            | _ ->
                catch_break false;
                close_data_connection data;
                raise Connect_reset
           );
           get_reply_code (read_reply cc)
          )
      | _ -> 
          close_data_connection data_descr;
          reply_code)
  | _ -> 
      reply_code

let nlist_files session pathname =
  let cc = session.cc in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE (ASIIC NONPRINT))) 
  in
  match reply_code.[0] with
  | '2' ->
      let data_descr = 
        try 
          init_data_connection session
        with
        | _ -> 
            raise Data_connect_failed
      in
      let reply_code = 
        get_reply_code (feed_command cc (NLST pathname))
      in
      (match reply_code.[0] with 
      | '1' -> 
          let data = 
            try
              open_data_connection session.passive data_descr
            with
            | Data_connect_failed ->
                close_data_connection data_descr;
                raise Data_connect_failed
          in
          (
           catch_break true;
           (
            try
              while true do
                let line = recv_line data in
                print_normal_msg (
                  (iconv_line (remove_trailing_cr_lf line) 
                              session.charset !console_charset)
                  ^"\n")
              done;
              catch_break false;
              close_data_connection data
            with
            | End_of_file ->
                catch_break false;
                close_data_connection data;
                ()
            | Break ->
                catch_break false;
                send_command cc ABOR;
                close_data_connection data;
                let _ = read_reply cc in ();
                print_debug_msg "Transfer aborted.\n";
                ()
            | _ ->
                catch_break false;
                close_data_connection data;
                raise Connect_reset
           );
           get_reply_code (read_reply cc)
          )
      | _ -> 
          close_data_connection data_descr;
          reply_code)
  | _ -> 
      reply_code

(******************************************************************************)

let get_local_file_kind pathname =
  let f_st = 
    try 
      stat pathname
    with
    | Unix_error (errno,s1,s2) -> raise (Unix_error (errno,s1,s2))
  in
  f_st.st_kind

(* TODO: get file size without raw ftp command SIZE *)
let get_remote_file_size session pathname =
  let cc = session.cc in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE IMAGE))
  in
  (match reply_code.[0] with
  | '2' 
  | _ -> ());
  let reply = 
    feed_command cc (SIZE pathname)
  in
  let reply_code = 
    get_reply_code reply
  in
  match reply_code.[0] with
  | '2' -> 
      let reply_content_len = (String.length reply)-4 in
      let reply_content = String.sub reply 4 reply_content_len in
      let size_str = remove_trailing_cr_lf reply_content in
      let size = Int64.of_string size_str in
      reply_code, size
  | _ -> reply_code, Int64.minus_one

(******************************************************************************)

let retrieve_file session remote_file local_file append continue =
  let cc = session.cc in
  let fin_name = remote_file in
  let fout_name = 
    if (String.compare local_file "")=0 then 
      Filename.basename (iconv_line fin_name !server_charset !console_charset)
    else 
      let fout_kind =
        try 
          get_local_file_kind local_file
        with
        | _ -> S_REG
      in
      (match fout_kind with
      | S_DIR -> local_file^"/"^(Filename.basename (iconv_line fin_name !server_charset !console_charset))
      | _ -> local_file)
  in
  let flag = 
    if continue||append then 
      [O_WRONLY; O_APPEND] 
    else 
      [O_CREAT; O_WRONLY; O_TRUNC]
  in
  let fout_descr = 
    try 
      openfile fout_name flag 0o600 
    with
    | Unix_error (errno, s1, s2) -> 
        raise (Unix_error (errno, s1, s2))
  in
  let fout_stat = LargeFile.fstat fout_descr in
  let start_byte = 
    if continue then 
      fout_stat.LargeFile.st_size 
    else 
      Int64.zero 
  in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE IMAGE))
  in
  (match reply_code.[0] with
  | '2' ->
      let data_descr =
        try
          init_data_connection session
        with
        | _ -> 
            raise Data_connect_failed
      in
      if continue then
        (let reply_code = 
          get_reply_code (feed_command cc (REST start_byte))
        in
        (match reply_code.[0] with
        | '3' -> ()
        | _ -> 
            raise Reset_failed));
      let reply_code = 
        get_reply_code (feed_command cc (RETR fin_name))
      in
      (match reply_code.[0] with
      | '1' ->
          (
           try
             recv_data session data_descr fout_descr !retransfer_timer
           with
           | End_of_file ->
               ()
           | File_write_failed ->
               raise File_write_failed
           | Time_out ->
               raise Time_out
           | _ -> 
               raise Connect_reset);
          get_reply_code (read_reply cc)
      | _ -> 
          close_data_connection data_descr;
          close fout_descr;
          reply_code)
  | _ -> 
      close fout_descr;
      reply_code)

(******************************************************************************)

let store_file session local_file remote_file append continue =
  let cc = session.cc in
  let fin_name = local_file in
  let fin_descr =
    try 
      openfile fin_name [O_RDONLY] 0o444
    with
    | Unix_error (errno, s1, s2) -> raise (Unix_error (errno, s1, s2))
  in
  let basename = Filename.basename fin_name in
  let fout_name =
    if (String.compare remote_file "")=0 then 
      basename
    else 
      let len = String.length remote_file in
      if remote_file.[len-1]='/' then
        remote_file^basename
      else
        remote_file
  in
  let start_byte =
    if continue||append then
      let reply_code,remote_file_size = 
        get_remote_file_size session fout_name 
      in
      (match reply_code.[0] with
      | '2' -> remote_file_size
      | _ -> Int64.zero)
    else
      Int64.zero
  in
  let reply_code = 
    get_reply_code (feed_command cc (TYPE IMAGE))
  in
  match reply_code.[0] with
  | '2' ->
      let data_descr = 
        try 
          init_data_connection session
        with
        | _ -> raise Data_connect_failed
      in
      if continue then 
        (if 
          (Int64.compare 
             (LargeFile.lseek fin_descr start_byte SEEK_SET) 
             (Int64.minus_one))=0
        then 
          raise File_lseek_failed;
         let reply_code = 
           get_reply_code (feed_command cc (REST start_byte))
         in
         (match reply_code.[0] with
         | '3' -> ()
         | _ -> raise Reset_failed));
      let reply_code = 
        get_reply_code (feed_command cc (STOR fout_name))
      in
      (match reply_code.[0] with
      | '1' ->
          (
           try 
             send_data session data_descr fin_descr !retransfer_timer
           with
           | End_of_file ->
               ()
           | File_write_failed -> 
               raise File_write_failed
           | Time_out ->
               raise Time_out
           | _ -> 
               raise Connect_reset);
          get_reply_code (read_reply cc)
      | _ -> 
          close_data_connection data_descr;
          close fin_descr;
          reply_code)
  | _ -> 
      close fin_descr;
      reply_code
